﻿Imports System.Text.RegularExpressions
Imports System.Text
Imports System.Runtime.CompilerServices
Imports DSQL.Extensions

''' <summary>
''' 動的SQLパーサー
''' </summary>
''' <remarks></remarks>
Public Class DSQLParser
    ''' <summary>
    ''' DBコマンドを作成します
    ''' </summary>
    ''' <param name="cn">DBコネクション</param>
    ''' <param name="dsql">DynamicSQL</param>
    ''' <param name="prefix">パラメータ接頭語</param>
    ''' <param name="params">パラメータ値辞書</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function CreateDbCommand(cn As IDbConnection, dsql As String, prefix As String, params As Dictionary(Of String, Object)) As IDbCommand
        Dim cmd As IDbCommand = cn.CreateCommand

        'パラメータ追加
        Dim paramAdder As Action(Of String, Object) =
            Sub(name As String, value As Object)
                If cmd.Parameters.Contains(name) Then Return
                Dim prm As IDbDataParameter = cmd.CreateParameter
                prm.ParameterName = name
                prm.Value = If(value Is Nothing, DBNull.Value, value)
                cmd.Parameters.Add(prm)
            End Sub

        'コマンドテキスト代入
        cmd.CommandText = Read(dsql, prefix, params, paramAdder)
        If cmd.CommandText.Any = False Then cmd.CommandText = dsql

        Return cmd
    End Function

    ''' <summary>
    ''' StaticSQLを作成します
    ''' </summary>
    ''' <param name="dsql"></param>
    ''' <param name="prefix">DynamicSQL</param>
    ''' <param name="params">ラメータ接頭語</param>
    ''' <param name="paramAdder">パラメータ値辞書</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function Read(dsql As String, prefix As String, params As Dictionary(Of String, Object), paramAdder As Action(Of String, Object)) As String
        Return ReadBlock(dsql, prefix, params, paramAdder)
    End Function

    ''' <summary>
    ''' ブロック読み込み
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks>
    ''' 中身がない場合、コマンド（where、order by）自体を消す
    ''' </remarks>
    Private Shared Function ReadBlock(dsql As String, prefix As String, params As Dictionary(Of String, Object), paramAdder As Action(Of String, Object)) As String
        'ブロック書式
        Const WHERE_BLOCK As String = "/\*ds begin\*/.*?(?<command>(where|order\sby))(?<block>.*?)/\*ds end begin\*/[ ]?"

        Dim s As New StringBuilder
        Dim pos As Integer = 0

        'dsqlを解析
        Dim m As Match = Regex.Match(dsql, WHERE_BLOCK, RegexOptions.IgnoreCase Or RegexOptions.Singleline)
        If m.Success = False Then Return ReadAsIfBlock(dsql, prefix, params, paramAdder)

        While m.Success
            Dim g As Group = m.Groups("command")
            Dim block As Group = m.Groups("block")
            Dim parts As String = ReadAsIfBlock(block.Value, prefix, params, paramAdder)

            'コマンドテキスト
            If String.IsNullOrEmpty(parts) Then
                'ブロックが空の場合、コマンド句なしとする
                s.AppendFormat("{0} ", dsql.Substring(pos, m.Index - pos))
            Else
                'ブロックが空でない場合、コマンド句を記述する
                s.AppendFormat("{0}{1}{2} ", dsql.Substring(pos, m.Index - pos), g.Value, parts.ToString)
            End If

            '事後処理
            pos = m.Index + m.Length
            m = m.NextMatch
        End While

        Return s.ToString.TrimEnd
    End Function

    ''' <summary>
    ''' IFブロック読み込み
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks>
    ''' NULLの場合条件式自体を消す
    ''' </remarks>
    Private Shared Function ReadAsIfBlock(dsql As String, prefix As String, params As Dictionary(Of String, Object), paramAdder As Action(Of String, Object)) As String
        '書式
        Const IF_BLOCK As String = "/\*ds if (?<name>.*?)[ ]?\!\=[ ]?null\*/[ ]?\r\n(?<block>.*?)\r\n/\*ds end if\*/[ ]?"

        Dim s As New StringBuilder
        Dim pos As Integer = 0

        'dsqlを解析
        Dim m As Match = Regex.Match(dsql, IF_BLOCK, RegexOptions.IgnoreCase Or RegexOptions.Singleline)
        If m.Success = False Then Return ReadAsParamCode(dsql, prefix, params, paramAdder)

        While m.Success
            Dim g As Group = m.Groups("name")
            Dim block As Group = m.Groups("block")
            Dim val = If(params.Keys.Contains(g.Value) = False, Nothing, params.Item(g.Value))
            Dim parts As String = String.Empty

            If Not (val Is Nothing OrElse DBNull.Value.Equals(val)) Then
                parts = ReadAsParamCode(block.Value, prefix, params, paramAdder)
            End If

            'コマンドテキスト
            If String.IsNullOrEmpty(parts) = False Then
                '演算子（接頭書式）の処理
                Const PREFIX_OPERATOR_CODE As String = "^(?<space>\s*)(?<operator>(and|or)\s*)(?<code>.*)"

                Dim mPrefix As Match = Regex.Match(parts, PREFIX_OPERATOR_CODE, RegexOptions.IgnoreCase)
                Dim tmp As String = dsql.Substring(pos, m.Index - pos)

                If s.Length = 0 AndAlso String.IsNullOrEmpty(mPrefix.Groups("operator").Value) = False Then
                    s.AppendFormat("{0}{1}{2}", tmp, mPrefix.Groups("space").Value, mPrefix.Groups("code").Value)
                Else
                    s.AppendFormat("{0}{1}", tmp, parts.ToString)
                End If
            End If

            '事後処理
            pos = m.Index + m.Length
            m = m.NextMatch
        End While

        '演算子（接尾書式）の処理
        Const SUFFIX_OPERATOR_CODE As String = "(?<code>.*)(?<op>(and|or))\s*$"
        Dim opSuffix As Match = Regex.Match(s.ToString, SUFFIX_OPERATOR_CODE, RegexOptions.IgnoreCase Or RegexOptions.Singleline)
        If opSuffix.Success Then
            Return opSuffix.Groups("code").Value.TrimEnd
        Else
            Return s.ToString.TrimEnd
        End If
    End Function

    ''' <summary>
    ''' パラメータコード読み込み
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks>
    ''' …/*ds 条件名*/ダミー値 …
    ''' <code>Age Between /*ds minage*/30 AND /*ds maxage*/40</code>
    ''' </remarks>
    Private Shared Function ReadAsParamCode(dsql As String, prefix As String, params As Dictionary(Of String, Object), paramAdder As Action(Of String, Object)) As String
        'パラメータ書式
        Const PARAM_CODE As String = "/\*ds (?<hard>\$?)(?<name>[^ ]+)\*/(?<dummy>[^ ]+)(?<space> ?)"

        Dim s As New StringBuilder
        Dim pos As Integer = 0

        'dsqlを解析
        Dim m As Match = Regex.Match(dsql, PARAM_CODE, RegexOptions.IgnoreCase)
        If m.Success = False Then Return dsql

        Dim increment As Action =
            Sub()
                pos = m.Index + m.Length
                m = m.NextMatch
            End Sub

        While m.Success
            Dim g As Group = m.Groups("name")
            Dim sp As Group = m.Groups("space")

            If params.ContainsKey(g.Value) = False Then
                increment.Invoke()
                Continue While
            End If

            Dim val = params.Item(g.Value)

            Dim parts As String = String.Empty
            If String.IsNullOrEmpty(m.Groups("hard").Value) Then
                '$で始まらない場合、パラメータ
                parts = CreateParameterCode(g.Value, val, prefix, paramAdder)
            Else
                '$で始まる場合、埋め込み
                parts = CreateHardCode(g.Value, val)
            End If

            'コマンドテキスト
            Dim pre = dsql.Substring(pos, m.Index - pos)
            If Regex.IsMatch(pre, "\sin\s.*$", RegexOptions.IgnoreCase) Then
                'IN句による括弧書き追加
                parts = parts.Decorate("({0})")
            End If
            s.AppendFormat("{0}{1}{2}", pre, parts, sp.Value)

            '事後処理
            increment.Invoke()
        End While

        '残った文字列はそのまま付け足す
        s.Append(dsql.Substring(pos, dsql.Length - pos))

        Return s.ToString.TrimEnd
    End Function

    Private Shared Function CreateParameterCode(name As String, val As Object, prefix As String, paramAdder As Action(Of String, Object)) As String
        Dim vals = TryCast(val, ICollection)
        Dim parts As New StringBuilder

        If vals Is Nothing Then
            '標準
            paramAdder.Invoke(name, val)
            parts.AppendFormat("{0}{1}", prefix, name)
        Else
            '配列
            Dim idx As Integer = 0
            For Each item In vals
                Dim s As String = String.Format("{0}_{1}", name, idx)
                paramAdder.Invoke(s, item)
                parts.AppendDelimiter(", ").AppendFormat("{0}{1}", prefix, s)
                idx += 1
            Next
        End If

        Return parts.ToString
    End Function

    Private Shared Function CreateHardCode(name As String, val As Object) As String
        Dim vals = TryCast(val, ICollection)
        Dim parts As New StringBuilder

        If vals Is Nothing Then
            '標準
            parts.Append(val.ToString)
        Else
            '配列
            For Each item In vals
                parts.AppendDelimiter(", ").Append(item.ToString)
            Next
        End If

        Dim s = parts.ToString
        If s.Contains(";") Then Throw New ArgumentException(";を埋め込むことはできません。")
        Return s
    End Function

End Class

'拡張メソッドは別の名前空間を切っておき、既存コードへの影響を排除する
Namespace Extensions
    ''' <summary>
    ''' StringBuilder拡張メソッド
    ''' </summary>
    ''' <remarks></remarks>
    Public Module StringBuilderExtension
        ''' <summary>
        ''' 区切り文字を追加します。文字が存在しない場合は追加しません
        ''' </summary>
        ''' <param name="source"></param>
        ''' <param name="delimiter"></param>
        ''' <returns></returns>
        ''' <remarks></remarks>
        <Extension()>
        Public Function AppendDelimiter(source As StringBuilder, delimiter As String) As StringBuilder
            If source.Length <> 0 Then
                source.Append(delimiter)
            End If
            Return source
        End Function
    End Module

    ''' <summary>
    ''' String拡張メソッド
    ''' </summary>
    ''' <remarks></remarks>
    Public Module StringExtension
        ''' <summary>
        ''' デコレートします
        ''' </summary>
        ''' <param name="source"></param>
        ''' <param name="format">{0}に現在値が入ります。</param>
        ''' <returns></returns>
        ''' <remarks><code>s.Decorate("({0})")</code></remarks>
        <Extension()>
        Public Function Decorate(ByRef source As String, format As String) As String
            If source.Length = 0 Then Return source
            Return String.Format(format, source)
        End Function
    End Module

    ''' <summary>
    ''' IDbCommand拡張メソッド
    ''' </summary>
    ''' <remarks></remarks>
    Public Module IDbCommandExtension
        ''' <summary>
        ''' DBコマンドの情報を返します
        ''' </summary>
        ''' <param name="source"></param>
        ''' <returns></returns>
        ''' <remarks>デバッグ用のメソッド。</remarks>
        <Extension()>
        Public Function ToInfoString(source As IDbCommand) As String
            'CommandText Info
            Dim s As New StringBuilder
            s.Append(source.CommandText)
            If source.Parameters.Count = 0 Then
                Return s.ToString
            End If

            s.AppendLine()

            'Parameter Info
            Dim prms As New StringBuilder
            For Each item As IDataParameter In source.Parameters
                prms.AppendDelimiter(", ").AppendFormat("{0}={1}", item.ParameterName, item.Value.ToString)
            Next
            s.AppendFormat("--{0}", prms.ToString)

            Return s.ToString
        End Function
    End Module
End Namespace

